home *** CD-ROM | disk | FTP | other *** search
/ EuroCD 3 / EuroCD 3.iso / Programming / vbcc / machines / amiga68k / libsrc / math / math_040 / tanh.s < prev   
Encoding:
Text File  |  1998-06-24  |  6.4 KB  |  163 lines
  1. *
  2. *   $VER: tanh.s 33.1 (22.1.97)
  3. *
  4. *   hyperbolic tangent
  5. *
  6. *   Version history:
  7. *
  8. *   33.1    22.1.97 (c) Motorola
  9. *
  10. *           - snipped from M68060SP sources
  11. *
  12.  
  13.     machine 68040
  14.     fpu     1
  15.  
  16.     XDEF    _tanh
  17.     XDEF    @tanh
  18.  
  19.     XREF    @exp
  20.     XREF    @expm1
  21.  
  22. *************************************************************************
  23. * tanh():  computes the hyperbolic tangent of a normalized input        *
  24. *                                                                       *
  25. * INPUT *************************************************************** *
  26. *       fp0 = extended precision input                                  *
  27. *                                                                       *
  28. * OUTPUT ************************************************************** *
  29. *       fp0 = tanh(X)                                                   *
  30. *                                                                       *
  31. * ACCURACY and MONOTONICITY ******************************************* *
  32. *       The returned result is within 3 ulps in 64 significant bit,     *
  33. *       i.e. within 0.5001 ulp to 53 bits if the result is subsequently *
  34. *       rounded to double precision. The result is provably monotonic   *
  35. *       in double precision.                                            *
  36. *                                                                       *
  37. * ALGORITHM *********************************************************** *
  38. *                                                                       *
  39. *       TANH                                                            *
  40. *       1. If |X| >= (5/2) log2 or |X| <= 2**(-40), go to 3.            *
  41. *                                                                       *
  42. *       2. (2**(-40) < |X| < (5/2) log2) Calculate tanh(X) by           *
  43. *               sgn := sign(X), y := 2|X|, z := expm1(Y), and           *
  44. *               tanh(X) = sgn*( z/(2+z) ).                              *
  45. *               Exit.                                                   *
  46. *                                                                       *
  47. *       3. (|X| <= 2**(-40) or |X| >= (5/2) log2). If |X| < 1,          *
  48. *               go to 7.                                                *
  49. *                                                                       *
  50. *       4. (|X| >= (5/2) log2) If |X| >= 50 log2, go to 6.              *
  51. *                                                                       *
  52. *       5. ((5/2) log2 <= |X| < 50 log2) Calculate tanh(X) by           *
  53. *               sgn := sign(X), y := 2|X|, z := exp(Y),                 *
  54. *               tanh(X) = sgn - [ sgn*2/(1+z) ].                        *
  55. *               Exit.                                                   *
  56. *                                                                       *
  57. *       6. (|X| >= 50 log2) Tanh(X) = +-1 (round to nearest). Thus, we  *
  58. *               calculate Tanh(X) by                                    *
  59. *               sgn := sign(X), Tiny := 2**(-126),                      *
  60. *               tanh(X) := sgn - sgn*Tiny.                              *
  61. *               Exit.                                                   *
  62. *                                                                       *
  63. *       7. (|X| < 2**(-40)). Tanh(X) = X.       Exit.                   *
  64. *                                                                       *
  65. *************************************************************************
  66.  
  67.  
  68. X       EQU             -12
  69. XFRAC   EQU             X+4
  70. V       EQU             -12
  71. SGN     EQU             -16
  72.  
  73. TEMP_SIZE EQU           16
  74.  
  75. _tanh
  76.         fmove.d         (4,sp),fp0
  77. @tanh
  78.         link            a0,#-TEMP_SIZE
  79.         fmove.x         fp0,(X,a0)
  80.         move.l          (X,a0),d1
  81.         move.w          (XFRAC,a0),d1
  82.         move.l          d1,(X,a0)
  83.         and.l           #$7FFFFFFF,d1
  84.         cmp.l           #$3fd78000,d1           ; is |X| < 2^(-40)?
  85.         blt.w           .TANHBORS               ; yes
  86.         cmp.l           #$3fffddce,d1           ; is |X| > (5/2)LOG2?
  87.         bgt.w           .TANHBORS               ; yes
  88.  
  89. ;--THIS IS THE USUAL CASE
  90. ;--Y = 2|X|, Z = EXPM1(Y), TANH(X) = SIGN(X) * Z / (Z+2).
  91.  
  92.         move.l          (X,a0),d1
  93.         move.l          d1,(SGN,a0)
  94.         and.l           #$7FFF0000,d1
  95.         add.l           #$00010000,d1           ; EXPONENT OF 2|X|
  96.         move.l          d1,(X,a0)
  97.         and.l           #$80000000,(SGN,a0)
  98.         fmove.x         (X,a0),fp0              ; FP0 IS Y = 2|X|
  99.  
  100.         jsr             @expm1                  ; FP0 IS Z = EXPM1(Y)
  101.  
  102.         fmove.x         fp0,fp1
  103.         fadd.s          #$40000000,fp1          ; Z+2
  104.         move.l          (SGN,a0),d1
  105.         fmove.x         fp1,(V,a0)
  106.         eor.l           d1,(V,a0)
  107.  
  108.         fdiv.x          (V,a0),fp0
  109.         unlk            a0
  110.         rts
  111.  
  112. .TANHBORS
  113.         cmp.l           #$3FFF8000,d1
  114.         blt.w           .TANHSM
  115.  
  116.         cmp.l           #$40048AA1,d1
  117.         bgt.w           .TANHHUGE
  118.  
  119. ;-- (5/2) LOG2 < |X| < 50 LOG2,
  120. ;--TANH(X) = 1 - (2/[EXP(2X)+1]). LET Y = 2|X|, SGN = SIGN(X),
  121. ;--TANH(X) = SGN -      SGN*2/[EXP(Y)+1].
  122.  
  123.         move.l          (X,a0),d1
  124.         move.l          d1,(SGN,a0)
  125.         and.l           #$7FFF0000,d1
  126.         add.l           #$00010000,d1           ; EXPO OF 2|X|
  127.         move.l          d1,(X,a0)               ; Y = 2|X|
  128.         and.l           #$80000000,(SGN,a0)
  129.         move.l          (SGN,a0),d1
  130.         fmove.x         (X,a0),fp0              ; Y = 2|X|
  131.  
  132.         jsr             @exp                    ; FP0 IS EXP(Y)
  133.  
  134.         move.l          (SGN,a0),d1
  135.         fadd.s          #$3F800000,fp0          ; EXP(Y)+1
  136.  
  137.         eor.l           #$C0000000,d1           ; -SIGN(X)*2
  138.         fmove.s         d1,fp1                  ; -SIGN(X)*2 IN SGL FMT
  139.         fdiv.x          fp0,fp1                 ; -SIGN(X)2 / [EXP(Y)+1 ]
  140.  
  141.         move.l          (SGN,a0),d1
  142.         or.l            #$3F800000,d1           ; SGN
  143.         fmove.s         d1,fp0                  ; SGN IN SGL FMT
  144.  
  145.         fadd.x          fp1,fp0
  146. .TANHSM
  147.         unlk            a0
  148.         rts
  149.  
  150. ;---RETURN SGN(X) - SGN(X)EPS
  151. .TANHHUGE
  152.         move.l          (X,a0),d1
  153.         and.l           #$80000000,d1
  154.         or.l            #$3F800000,d1
  155.         fmove.s         d1,fp0
  156.         and.l           #$80000000,d1
  157.         eor.l           #$80800000,d1           ; -SIGN(X)*EPS
  158.  
  159.         fadd.s          d1,fp0
  160.         unlk            a0
  161.         rts
  162.  
  163.